The Games Machine 131/XENIATGM131.iso/Shareware/openOffice.org 641/Windows/f_0017/tools.xba

Extensible Markup Language | 2001-11-22 | 9KB | 285 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM  *****  BASIC  *****
Option Explicit


Function SetProgressValue(iValue as Integer)
    If iValue = 0 Then
        oProgressbar.End
    End If
    ProgressValue = iValue
    oProgressbar.Value = iValue
End Function


Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
Dim aPeerSize as new com.sun.star.awt.Size
Dim nWidth as Integer
Dim oControl as Object
    If Not IsMissing(LocText) Then
        ' Label
        aPeerSize = GetPeerSize(oModel, oControl, LocText)
    ElseIf CurControlType = cImageControl Then
        GetPreferredWidth() = 2000
        Exit Function
    Else
        aPeerSize = GetPeerSize(oModel, oControl)
    End If
    nWidth = aPeerSize.Width
    ' We increase the preferred Width a bit so that the control does not become too small
    ' when we change the border from "3D" to "Flat"
    GetPreferredWidth = (nWidth + 5) * XPixelFactor    ' PixelTo100thmm(nWidth)
End Function


Function GetPreferredHeight(oModel as Object, Optional LocText)
Dim aPeerSize as new com.sun.star.awt.Size
Dim nHeight as Integer
Dim oControl as Object
    If Not IsMissing(LocText) Then
        ' Label
        aPeerSize = GetPeerSize(oModel, oControl, LocText)
    ElseIf CurControlType = cImageControl Then
        GetPreferredHeight() = 2000
        Exit Function
    Else
        aPeerSize = GetPeerSize(oModel, oControl)
    End If
    nHeight = aPeerSize.Height
    ' We increase the preferred Height a bit so that the control does not become too small
    ' when we change the border from "3D" to "Flat"
    GetPreferredHeight = (nHeight+1) * YPixelFactor     ' PixelTo100thmm(nHeight)
End Function


Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
Dim oPeer as Object
Dim aPeerSize as new com.sun.star.awt.Size
Dim NullValue
    oControl = oController.GetControl(oModel)
    oPeer = oControl.GetPeer()
    If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
        If oControl.Model.EffectiveMax = 0 Then
            ' This is relevant for decimal fields
            oControl.Model.EffectiveValue = 999.9999
        Else
            oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
        End If
        GetPeerSize() = oPeer.PreferredSize()
        oControl.Model.EffectiveValue = NullValue
    ElseIf Not IsMissing(LocText) Then
        oControl.Text = LocText
        GetPeerSize() = oPeer.PreferredSize()
    ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
        GetPeerSize() = oPeer.PreferredSize()
    ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
        oControl.Model.Date = Date
        GetPeerSize() = oPeer.PreferredSize()
        oControl.Model.Date = NullValue
    ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
        oControl.Time = Time
        GetPeerSize() = oPeer.PreferredSize()
        oControl.Time = NullValue
    Else
        oControl.Text = Mid(SBSIZETEXT,1,oControl.MaxTextLen)
        GetPeerSize() = oPeer.PreferredSize()
        oControl.Text = ""
    End If
End Function


Function TwipToCM(BYVAL nValue as long) as String
    TwipToCM = trim(str(nValue / 567)) + "cm"
End function


Function TwipTo100telMM(BYVAL nValue as long) as long
     TwipTo100telMM = nValue / 0.567
End function


Function TwipToPixel(BYVAL nValue as long) as long ' nur ungefaehre Berechnung
    TwipToPixel = nValue / 15
End function


Function PixelTo100thMMX(oControl as Object) as long
    oPeer = oControl.GetPeer()
    PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)

'     PixelTo100thMM = nValue * 28                    ' nur ungefähre Berechnung
End function


Function PixelTo100thMMY(oControl as Object) as long
    oPeer = oControl.GetPeer()
    PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)

'     PixelTo100thMM = nValue * 28                    ' nur ungefähre Berechnung
End function


Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
Dim aPoint as New com.sun.star.awt.Point
    aPoint.X = xPos
    aPoint.Y = yPos
    GetPoint() = aPoint
End Function


Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
Dim aSize As New com.sun.star.awt.Size
    aSize.Width = iWidth
    aSize.Height = iHeight
    GetSize() = aSize
End Function


Sub    ImportStyles()
Dim OldIndex as Integer
    If Not bDebug Then
        On Local Error GoTo WIZARDERROR
    End If
    OldIndex = CurIndex
    CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
    If CurIndex <> OldIndex Then
        ToggleLayoutPage(False)
        SetImportStyle()
        ToggleOptionButtons(oDialogModel, bWithBackGraphic)
        ToggleLayoutPage(True, "lstStyles")
    End If
WIZARDERROR:
    If Err <> 0 Then
        Msgbox(sMsgErrMsg, 16, GetProductName())
        Resume LOCERROR
        LOCERROR:
    End If
End Sub


Sub SetImportStyle()
Dim sImportPath as String
    sImportPath = Styles(8,CurIndex)
    bWithBackGraphic = LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
    ControlCaptionsToStandardLayout()
End Sub


Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
    Select Case iLocFieldType
        Case com.sun.star.sdbc.DataType.BIGINT
            oLocObOject.EffectiveMax = 2147483647 * 2147483647
            oLocbject.EffectiveMin = -(-2147483648 * -2147483648)
            oLocObject.DecimalAccuracy = 0
        Case com.sun.star.sdbc.DataType.INTEGER
            oLocObject.EffectiveMax = 2147483647
            oLocObject.EffectiveMin = -2147483648
        Case  com.sun.star.sdbc.DataType.SMALLINT
            oLocObject.EffectiveMax = 32767
            oLocObject.EffectiveMin = -32768
        Case com.sun.star.sdbc.DataType.TINYINT
            oLocObject.EffectiveMax = 127
            oLocObject.EffectiveMin = -128
        Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
'        oLocObject.Scale = 0
        ' Todo: Hier sollte die Property "Scale" zusammen mit der Precision abgefragt werden, um die Nachkommastellen richtig darzustellen,
        ' da ein EffectiveMax/EffectiveMin hier keinen Sinn macht
'            oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen
        Case com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
            If oLocObject.MaxTextLen = 0 Or oLocObject.MaxTextLen > 30 Then
                oLocObject.MaxTextLen = 30
                CurFieldLength = 30
            Else
                oLocObject.MaxTextLen = CurFieldLength
            End If
'            oLocObject.DefaultText = Mid(SBSIZETEXT,1,CurFieldLength)
        Case com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
'            oLocObject.MaxTextLen = CurFieldLength
    End Select

End Function


' Destroy all Shapes in Nirwana
Sub RemoveShapes()
Dim n as Integer
Dim oControl as Object
Dim oShape as Object
    For n = oDrawPage.Count-1 To 0 Step -1
        oShape = oDrawPage(n)
        If oShape.Position.Y > -2000 Then
            oDrawPage.Remove(oShape)
        End If
    Next n
End Sub


' Note as Shapes cannot be removed from the DrawPage without destroying
' the object we have to park them somewhere in Nirwana
Sub ShapesToNirwana()
Dim n as Integer
Dim oControl as Object
    For n = 0 To oDrawPage.Count-1
        oDrawPage(n).Position = GetPoint(-20, -10000)
    Next n
End Sub


Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String
Dim nPostfix as Integer
Dim sReturn as String
    nPostfix = 2
    sReturn = sBaseName

    while (oContainer.hasByName(sReturn))
        sReturn = sBaseName & nPostfix
        nPostfix = nPostfix + 1
    Wend
    CalcUniqueContentName = sReturn
End Function


Function CountItemsInArray(BigArray(), SearchItem)
Dim i as Integer
Dim MaxIndex as Integer
Dim ResCount as Integer
    ResCount = 0
    MaxIndex = Ubound(BigArray())
    For i = 0 To MaxIndex
        If SearchItem = BigArray(i) Then
            ResCount = ResCount + 1
        End If
    Next i
    CountItemsInArray() = ResCount
End Function


Function GetDBHeight(oDBModel as Object)
    If CurControlType = cImageControl Then
        nDBHeight = 2000
    Else
        If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
            oDBModel.MultiLine = True
            nDBHeight = nDBRefHeight * 4
        Else
            nDBHeight = nDBRefHeight
        End If
    End If
    GetDBHeight() = nDBHeight
End Function


'Sub ShowErrorMessage(bEndExecute as Boolean)
'    If Err <> 0 Then
'        Msgbox(sMsgErrMsg, 16, GetProductName())
'        Resume LOCERROR
'        LOCERROR:
'        On Local Error Goto 0
'        oDocument.UnlockControllers()
'        ToggleWindow(True)
'        If bEndExecute Then
'            DlgFormDB.EndExecute()
'        End If
'    End If
'End Sub</script:module>